COVID19 UK

Prepare data

Read and format data

Prevalence

df_uk_covid <- read_csv('timeseries_uk_utla_march9_april_09.csv')

Parsed with column specification:
cols(
  ut_area = col_character(),
  time = col_double(),
  areaname = col_character(),
  open = col_double(),
  extra = col_double(),
  agree = col_double(),
  neuro = col_double(),
  sci = col_double(),
  frequ = col_double(),
  ut_name = col_character(),
  poptotal = col_double(),
  rate_day = col_double()
)

df_uk <- df_uk_covid %>% filter(time <=22) %>% 
  dplyr::rename(pers_o = open, 
         pers_c = sci,
         pers_e = extra,
         pers_a = agree,
         pers_n = neuro) %>%
  select(-ut_name, -areaname, -poptotal) %>%
  drop_na()

df_uk %>% head()

NA

Social distancing

df_uk_socdist <- read_csv('UK_socdist_fb_nuts3.csv')

Parsed with column specification:
cols(
  nuts3 = col_character(),
  date = col_date(format = ""),
  all_day_bing_tiles_visited_relat = col_double(),
  all_day_ratio_single_tile_users = col_double(),
  open = col_double(),
  extra = col_double(),
  agree = col_double(),
  neuro = col_double(),
  sci = col_double(),
  frequ = col_double(),
  nuts3_name = col_character(),
  runday = col_double()
)

df_uk_socdist <- df_uk_socdist %>% select(-runday) %>%
  filter(date >= '2020-03-09' & date <= '2020-03-31') %>%
  group_by(nuts3) %>% 
  mutate(time = row_number()) %>%
  ungroup() %>% 
  dplyr::rename(pers_o = open, 
                pers_c = sci,
                pers_e = extra,
                pers_a = agree,
                pers_n = neuro) %>% 
  select(-nuts3_name) %>% 
  dplyr::rename(socdist_tiles = all_day_bing_tiles_visited_relat,
                socdist_single_tile = all_day_ratio_single_tile_users) %>%
  drop_na()
  
df_uk_socdist %>% head()

NA

Controls

df_uk_ctrl_nuts <- read_csv("controls_UK_nuts3.csv")

Parsed with column specification:
cols(
  nuts3 = col_character(),
  nuts3_name = col_character(),
  airport_dist = col_double(),
  males = col_double(),
  popdens = col_double(),
  manufacturing = col_double(),
  tourism = col_double(),
  health = col_double(),
  academic = col_double(),
  medinc = col_double(),
  medage = col_double(),
  conservative = col_double()
)

df_uk_ctrl_nuts <- df_uk_ctrl_nuts %>% select(-nuts3_name)
df_uk_ctrl_nuts

df_uk_ctrl_ut <- read_csv("controls_UK_ut.csv")

Parsed with column specification:
cols(
  ut_area = col_character(),
  ut_name = col_character(),
  airport_dist = col_double(),
  males = col_double(),
  popdens = col_double(),
  manufacturing = col_double(),
  tourism = col_double(),
  health = col_double(),
  academic = col_double(),
  medinc = col_double(),
  medage = col_double(),
  conservative = col_double()
)

df_uk_ctrl_ut <- df_uk_ctrl_ut %>% select(-ut_name)
df_uk_ctrl_ut

NA
NA

Merge data

Identify London areas

nuts_london_inner <- c('UKI31','UKI32','UKI33','UKI34','UKI41',
                      'UKI42','UKI43','UKI44','UKI45')

nuts_london_outer <- c('UKI51','UKI52','UKI53','UKI54','UKI61',
                      'UKI62','UKI63','UKI71','UKI72','UKI73',
                      'UKI74','UKI75')

ut_london_inner <- c('E09000007','E09000001','E09000033','E09000013',
                    'E09000020','E09000032','E09000025','E09000012',
                    'E09000030','E09000014','E09000019','E09000023',
                    'E09000028','E09000022')

ut_london_outer <- c('E09000011','E09000004','E09000016','E09000002',
                    'E09000031','E09000026','E09000010','E09000006',
                    'E09000008','E09000029','E09000021','E09000024',
                    'E09000003','E09000005','E09000009','E09000017',
                    'E09000015','E09000018','E09000027')

df_uk_socdist = df_uk_socdist %>% 
  mutate(london = ifelse(nuts3 %in% nuts_london_inner, 'london_inner', 
                       ifelse(nuts3 %in% nuts_london_outer, 'london_outer',
                              'country'))) %>%
  mutate(london = as.factor(london))

df_uk = df_uk %>% 
  mutate(london = ifelse(ut_area %in% ut_london_inner, 'london_inner', 
                       ifelse(ut_area %in% ut_london_outer, 'london_outer',
                              'country'))) %>%
  mutate(london = as.factor(london))

Explore data

Plot prevalence over time

df_uk %>% ggplot(aes(x=time, y=rate_day)) + 
  geom_point(aes(col=ut_area, size=popdens)) + 
  geom_smooth(method="loess", se=T) + 
  theme(legend.position="none") +
  ggtitle("Overall prevalence over time")

pers <- c('pers_o', 'pers_c', 'pers_e', 'pers_a', 'pers_n')

for (i in pers){

gg <- df_uk %>% mutate(prev_tail = cut(.[[i]], 
                                       breaks = c(-Inf, quantile(.[[i]], 0.2), quantile(.[[i]], 0.8), Inf),
                                       labels = c('lower tail', 'center', 'upper tail'))) %>% 
  filter(prev_tail != 'center') %>%
  ggplot(aes(x=time, y=rate_day)) + 
  geom_point(aes(col=ut_area, size=popdens)) + 
  geom_smooth(method="loess", se=T) + 
  facet_wrap(~prev_tail) + 
  theme(legend.position="none") +
  ggtitle(i)

print(gg)
}

Plot social distancing over time

df_uk_socdist %>% ggplot(aes(x=time, y=socdist_tiles)) + 
  geom_point(aes(col=nuts3, size=popdens)) + 
  geom_smooth(method="loess", se=T) + 
  theme(legend.position="none") +
  ggtitle("Overall social distancing over time")

pers <- c('pers_o', 'pers_c', 'pers_e', 'pers_a', 'pers_n')

for (i in pers){

gg <- df_uk_socdist %>% mutate(socdist_tail = cut(.[[i]], 
                                       breaks = c(-Inf, quantile(.[[i]], 0.2), quantile(.[[i]], 0.8), Inf),
                                       labels = c('lower tail', 'center', 'upper tail'))) %>% 
  filter(socdist_tail != 'center') %>%
  ggplot(aes(x=time, y=socdist_tiles)) + 
  geom_point(aes(col=nuts3, size=popdens)) + 
  geom_smooth(method="loess", se=T) + 
  facet_wrap(~socdist_tail) + 
  theme(legend.position="none") +
  ggtitle(i)

print(gg)
}

Explore differences between london and the rest

df_uk %>% ggplot(aes(x=time, y=rate_day)) + 
  geom_point(aes(col=ut_area, size=popdens)) + 
  geom_smooth(method="loess", se=T) + 
  theme(legend.position="none") +
  facet_wrap(~london) +
  ggtitle("Overall prevalence over time")

NA
NA
NA

df_uk_socdist %>% ggplot(aes(x=time, y=socdist_tiles)) + 
  geom_point(aes(col=nuts3, size=popdens)) + 
  geom_smooth(method="loess", se=T) + 
  theme(legend.position="none") +
  facet_wrap(~london) +
  ggtitle("Overall social distancing over time")

Correlations

df_uk %>% group_by(ut_area) %>% 
  summarize_if(is.numeric, mean, na.rm=T) %>% 
  select(-ut_area, -time) %>% 
  cor(use = 'pairwise.complete') %>% round(3)

         pers_o pers_e pers_a pers_n pers_c  frequ poptotal rate_day popdens
pers_o    1.000  0.734 -0.605 -0.144 -0.638  0.008   -0.097    0.646   0.801
pers_e    0.734  1.000 -0.413 -0.500 -0.294  0.065   -0.074    0.556   0.621
pers_a   -0.605 -0.413  1.000 -0.195  0.641  0.131    0.199   -0.585  -0.741
pers_n   -0.144 -0.500 -0.195  1.000 -0.351 -0.243   -0.124   -0.108   0.040
pers_c   -0.638 -0.294  0.641 -0.351  1.000  0.220    0.225   -0.489  -0.729
frequ     0.008  0.065  0.131 -0.243  0.220  1.000    0.949   -0.082  -0.195
poptotal -0.097 -0.074  0.199 -0.124  0.225  0.949    1.000   -0.128  -0.252
rate_day  0.646  0.556 -0.585 -0.108 -0.489 -0.082   -0.128    1.000   0.773
popdens   0.801  0.621 -0.741  0.040 -0.729 -0.195   -0.252    0.773   1.000

df_uk

NA

Modelling

Prepare functions

# function calculates all relevant models
run_models <- function(y, lvl1_x, lvl2_x, lvl2_id, data, ctrls=F){

  # subset data
  data = data %>% 
    dplyr::select(all_of(y), all_of(lvl1_x), all_of(lvl2_x), all_of(lvl2_id), 
                  popdens, all_of(y))
  data = data %>% 
    dplyr::rename(y = all_of(y),
           lvl1_x = all_of(lvl1_x),
           lvl2_x = all_of(lvl2_x),
           lvl2_id = all_of(lvl2_id)
           )
  
  # configure optimization procedure
  ctrl_config <- lmeControl(opt = 'optim', maxIter = 100, msMaxIter = 100)

  # baseline
  baseline <- lme(fixed = y ~ 1, random = ~ 1 | lvl2_id, 
                    data = data,
                    correlation = corAR1(),
                  control = ctrl_config,
                  method = 'ML')

  # random intercept fixed slope
  random_intercept <- lme(fixed = y ~ lvl1_x + lvl2_x, 
                          random = ~ 1 | lvl2_id,
                            data = data,
                            correlation = corAR1(),
                  control = ctrl_config,
                  method = 'ML')

  # random intercept random slope
  random_slope <- lme(fixed = y ~ lvl1_x + lvl2_x, 
                      random = ~ lvl1_x | lvl2_id, 
                        data = data,
                        correlation = corAR1(),
                  control = ctrl_config,
                  method = 'ML')

  # cross level interaction
  interaction <- lme(fixed = y ~ lvl1_x * lvl2_x, 
                     random = ~ lvl1_x | lvl2_id, 
                       data = data,
                       correlation = corAR1(),
                  control = ctrl_config,
                  method = 'ML')
  
  # create list with results
  results <- list('baseline' = baseline, 
                  "random_intercept" = random_intercept, 
                  "random_slope" = random_slope,
                  "interaction" = interaction)
  
  
  if (ctrls == 'dem' | ctrls == 'prev'){
    
    # random intercept random slope
    random_slope_ctrl_dem <- lme(fixed = y ~ lvl1_x + lvl2_x + popdens,
                              random = ~ lvl1_x | lvl2_id, 
                          data = data,
                          correlation = corAR1(),
                    control = ctrl_config,
                  method = 'ML')
  
    # cross level interaction
    interaction_ctrl_main_dem <- lme(fixed = y ~ lvl1_x * lvl2_x + popdens,
                             random = ~ lvl1_x | lvl2_id, 
                         data = data,
                         correlation = corAR1(),
                    control = ctrl_config,
                  method = 'ML')
  
    # cross level interaction
    interaction_ctrl_int_dem <- lme(fixed = y ~ lvl1_x * lvl2_x + lvl1_x * popdens,
                             random = ~ lvl1_x | lvl2_id, 
                         data = data,
                         correlation = corAR1(),
                    control = ctrl_config,
                  method = 'ML')        
    
    # create list with results
    results <- list('baseline' = baseline, 
                    "random_intercept" = random_intercept, 
                    "random_slope" = random_slope,
                    "interaction" = interaction,
                    "random_slope_ctrl_dem" = random_slope_ctrl_dem,
                    "interaction_ctrl_main_dem" = interaction_ctrl_main_dem,
                    "interaction_ctrl_int_dem" = interaction_ctrl_int_dem)
  }
  
  if (ctrls == 'prev'){
  
    # random intercept random slope
    random_slope_ctrl_prev <- lme(fixed = y ~ lvl1_x + lvl2_x + popdens + rate_day,
                              random = ~ lvl1_x + rate_day | lvl2_id, 
                          data = data,
                          correlation = corAR1(),
                          control = ctrl_config,
                  method = 'ML')  
    
        # cross level interaction
    interaction_ctrl_main_prev <- lme(fixed = y ~ lvl1_x * lvl2_x + popdens + rate_day,
                             random = ~ lvl1_x | lvl2_id, 
                         data = data,
                         correlation = corAR1(),
                    control = ctrl_config,
                  method = 'ML')
  
  
    # cross level interaction
    interaction_ctrl_int_prev<- lme(fixed = y ~ lvl1_x * lvl2_x + lvl1_x * popdens + rate_day,
                             random = ~ lvl1_x + rate_day | lvl2_id, 
                         data = data,
                         correlation = corAR1(),
                          control = ctrl_config,
                  method = 'ML')
  
    # create list with results
    results <- list('baseline' = baseline, 
                    "random_intercept" = random_intercept, 
                    "random_slope" = random_slope,
                    "interaction" = interaction,
                    "random_slope_ctrl_dem" = random_slope_ctrl_dem,
                    "interaction_ctrl_main_dem" = interaction_ctrl_main_dem,
                    "interaction_ctrl_int_dem" = interaction_ctrl_int_dem,                    
                    "random_slope_ctrl_prev" = random_slope_ctrl_prev,
                    "interaction_ctrl_main_prev" = interaction_ctrl_main_prev,
                    "interaction_ctrl_int_prev" = interaction_ctrl_int_prev)
  }
  
  if(ctrls == 'exp'){
    # random intercept random slope
  random_slope_exp <- lme(fixed = y ~ (lvl1_x + I(lvl1_x^2)) + lvl2_x, 
                      random = ~ (lvl1_x + I(lvl1_x^2)) | lvl2_id, 
                        data = data,
                        correlation = corAR1(),
                  control = ctrl_config,
                  method = 'ML')

  # cross level interaction
  interaction_exp <- lme(fixed = y ~ (lvl1_x + I(lvl1_x^2)) * lvl2_x, 
                     random = ~ (lvl1_x + I(lvl1_x^2)) | lvl2_id, 
                       data = data,
                       correlation = corAR1(),
                  control = ctrl_config,
                  method = 'ML')  
  
  
  # create list with results
  results <- list('baseline' = baseline, 
                  "random_intercept" = random_intercept, 
                  "random_slope" = random_slope,
                  "interaction" = interaction,                  
                  "random_slope_exp" = random_slope_exp,
                  "interaction_exp" = interaction_exp)
  }
  
  return(results)
        
}

# extracts table with coefficients and tests statistics
extract_results <- function(models) {
  
  models_summary <- models %>% 
  map(summary) %>% 
  map("tTable") %>% 
  map(as.data.frame) %>% 
  map(round, 10) 
  # %>% map(~ .[str_detect(rownames(.), 'Inter|lvl'),])
  
  return(models_summary)
  
}


# calculates comparison of all models in model list
compare_models <- function(models) {

  mdl_names <- models %>% names()
  
  str = ''
  for (i in mdl_names){
    
    mdl_str <- paste('models$', i, sep = '')
    
    if(i == 'baseline'){
      str <- mdl_str
    }else{
    str <- paste(str, mdl_str, sep=', ')
    }
  }
  
  anova_str <- paste0('anova(', str, ')')
  mdl_comp <- eval(parse(text=anova_str))
  rownames(mdl_comp) = mdl_names
  return(mdl_comp)
}

Remove London Data

df_uk <- df_uk %>% filter(london == 'country')
df_uk_socdist <- df_uk_socdist %>% filter(london == 'country')

Rescale Data

df_uk_scaled <- df_uk %>% dplyr::select(ut_area, time, pers_o, 
                                 pers_c, pers_e, pers_e, pers_a, pers_n,
                                 popdens, rate_day) %>%
  mutate_at(vars(-ut_area, -time), scale)

df_uk_scaled %>% head()

df_uk_socdist_scaled <- df_uk_socdist %>% dplyr::select(nuts3, time, pers_o, 
                                 pers_c, pers_e, pers_e, pers_a, pers_n,
                                 popdens, socdist_tiles) %>%
  mutate_at(vars(-nuts3, -time), scale)

df_uk_socdist_scaled %>% head()

NA

Predict prevalence

prevalence ~ openness

models_o_covid <-run_models(y = 'rate_day', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_o', 
                         lvl2_id = 'ut_area', 
                         data = df_uk_scaled,
                         ctrls = 'dem')

extract_results(models_o_covid)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_ctrl_dem

$interaction_ctrl_main_dem

$interaction_ctrl_int_dem

compare_models(models_o_covid)

NA

prevalence ~ conscientiousness

models_c_covid <-run_models(y = 'rate_day', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_c', 
                         lvl2_id = 'ut_area', 
                         data = df_uk_scaled,
                         ctrls = 'dem')

extract_results(models_c_covid)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_ctrl_dem

$interaction_ctrl_main_dem

$interaction_ctrl_int_dem

compare_models(models_c_covid)

NA
NA

prevalence ~ extraversion

models_e_covid <-run_models(y = 'rate_day', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_e', 
                         lvl2_id = 'ut_area', 
                         data = df_uk_scaled,
                         ctrls = 'dem')

extract_results(models_e_covid)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_ctrl_dem

$interaction_ctrl_main_dem

$interaction_ctrl_int_dem

compare_models(models_e_covid)

NA
NA

prevalence ~ agreeableness

models_a_covid <-run_models(y = 'rate_day', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_a', 
                         lvl2_id = 'ut_area', 
                         data = df_uk_scaled,
                         ctrls = 'dem')

extract_results(models_a_covid)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_ctrl_dem

$interaction_ctrl_main_dem

$interaction_ctrl_int_dem

compare_models(models_a_covid)

NA
NA

prevalence ~ neuroticism

models_n_covid <-run_models(y = 'rate_day', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_n', 
                         lvl2_id = 'ut_area', 
                         data = df_uk_scaled,
                         ctrls = 'dem')

extract_results(models_n_covid)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_ctrl_dem

$interaction_ctrl_main_dem

$interaction_ctrl_int_dem

compare_models(models_n_covid)

NA
NA

Predict social distancing

social distancing ~ openness

models_o_socdist <-run_models(y = 'socdist_tiles', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_o', 
                         lvl2_id = 'nuts3', 
                         data = df_uk_socdist_scaled,
                         ctrls = 'dem')

extract_results(models_o_socdist)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_ctrl_dem

$interaction_ctrl_main_dem

$interaction_ctrl_int_dem

compare_models(models_o_socdist)

NA

social distancing ~ conscientiousness

models_c_socdist <-run_models(y = 'socdist_tiles', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_c', 
                         lvl2_id = 'nuts3', 
                         data = df_uk_socdist_scaled,
                         ctrls = 'dem')

extract_results(models_c_socdist)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_ctrl_dem

$interaction_ctrl_main_dem

$interaction_ctrl_int_dem

compare_models(models_c_socdist)

NA
NA

social distancing ~ extraversion

models_e_socdist <-run_models(y = 'socdist_tiles', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_e', 
                         lvl2_id = 'nuts3', 
                         data = df_uk_socdist_scaled,
                         ctrls = 'dem')

extract_results(models_e_socdist)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_ctrl_dem

$interaction_ctrl_main_dem

$interaction_ctrl_int_dem

compare_models(models_e_socdist)

NA
NA

social distancing ~ agreeableness

models_a_socdist <-run_models(y = 'socdist_tiles', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_a', 
                         lvl2_id = 'nuts3', 
                         data = df_uk_socdist_scaled,
                         ctrls = 'dem')

extract_results(models_a_socdist)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_ctrl_dem

$interaction_ctrl_main_dem

$interaction_ctrl_int_dem

compare_models(models_a_socdist)

NA
NA

social distancing ~ neuroticism

models_n_socdist <-run_models(y = 'socdist_tiles', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_n', 
                         lvl2_id = 'nuts3', 
                         data = df_uk_socdist_scaled,
                         ctrls = 'dem')

extract_results(models_n_socdist)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_ctrl_dem

$interaction_ctrl_main_dem

$interaction_ctrl_int_dem

compare_models(models_n_socdist)

NA
NA

Explore quadratic trends

prevalence ~ openness

models_o_covid_exp <-run_models(y = 'rate_day',
                         lvl1_x = 'time',
                         lvl2_x = 'pers_o',
                         lvl2_id = 'ut_area',
                         data = df_uk_scaled,
                         ctrls = 'exp')

extract_results(models_o_covid_exp)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_exp

$interaction_exp

compare_models(models_o_covid_exp)

NA

prevalence ~ conscientiousness

models_c_covid_exp <-run_models(y = 'rate_day', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_c', 
                         lvl2_id = 'ut_area', 
                         data = df_uk_scaled,
                         ctrls = 'exp')

extract_results(models_c_covid_exp)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_exp

$interaction_exp

compare_models(models_c_covid_exp)

NA

prevalence ~ extraversion

models_e_covid_exp <-run_models(y = 'rate_day', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_e', 
                         lvl2_id = 'ut_area', 
                         data = df_uk_scaled,
                         ctrls = 'exp')

extract_results(models_e_covid_exp)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_exp

$interaction_exp

compare_models(models_e_covid_exp)

NA

prevalence ~ agreeableness

models_a_covid_exp <-run_models(y = 'rate_day', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_a', 
                         lvl2_id = 'ut_area', 
                         data = df_uk_scaled,
                         ctrls = 'exp')

extract_results(models_a_covid_exp)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_exp

$interaction_exp

compare_models(models_a_covid_exp)

NA

prevalence ~ neuroticism

models_n_covid_exp <-run_models(y = 'rate_day', 
                         lvl1_x = 'time', 
                         lvl2_x = 'pers_n', 
                         lvl2_id = 'ut_area', 
                         data = df_uk_scaled,
                         ctrls = 'exp')

extract_results(models_n_covid_exp)

$baseline

$random_intercept

$random_slope

$interaction

$random_slope_exp

$interaction_exp

compare_models(models_n_covid_exp)

NA

Create overview table

Define function to create overview tables

summary_table <- function(models, dv_name){

  temp_df_ctrl_main <- NULL
  temp_df_ctrl_int <- NULL
  
  for (i in models){
    results <- i %>% extract_results()
    
    results_ctrl_main <- results$interaction_ctrl_main_dem['lvl1_x:lvl2_x',]
    temp_df_ctrl_main <- temp_df_ctrl_main %>% rbind(results_ctrl_main)
    
    results_ctrl_int <- results$interaction_ctrl_int_dem['lvl1_x:lvl2_x',]
    temp_df_ctrl_int <- temp_df_ctrl_int %>% rbind(results_ctrl_int)
  }
  
  names_ctrl_main <- paste0(dv_name, '~', c('o', 'c', 'e', 'a', 'n'), '*time', '_crtl_popdens')
  names_ctrl_int <- paste0(dv_name, '~', c('o', 'c', 'e', 'a', 'n'), '*time', '_crtl_popdens*time')

  rownames(temp_df_ctrl_main) <- names_ctrl_main
  rownames(temp_df_ctrl_int) <- names_ctrl_int
  
  sum_tab <- rbind(temp_df_ctrl_main, temp_df_ctrl_int) %>% round(4)
  
  return(sum_tab)

} 

Create overview tables

# prevalence
models_prev <- list(models_o_covid, 
                    models_c_covid, 
                    models_e_covid, 
                    models_a_covid, 
                    models_n_covid)

sum_tab_prev <- summary_table(models_prev, dv_name = 'prev')

write.table(sum_tab_prev, quote=F)

Value Std.Error DF t-value p-value
prev~o*time_crtl_popdens 0.0037 0.0038 2413 0.9907 0.3219
prev~c*time_crtl_popdens -0.0177 0.0037 2413 -4.7421 0
prev~e*time_crtl_popdens -0.0033 0.0038 2413 -0.8744 0.382
prev~a*time_crtl_popdens -0.0131 0.0037 2413 -3.5102 5e-04
prev~n*time_crtl_popdens 0.0138 0.0037 2413 3.6925 2e-04
prev~o*time_crtl_popdens*time -0.0026 0.0039 2412 -0.6683 0.504
prev~c*time_crtl_popdens*time -0.0042 0.0051 2412 -0.8169 0.4141
prev~e*time_crtl_popdens*time -0.0049 0.0037 2412 -1.321 0.1866
prev~a*time_crtl_popdens*time -0.0048 0.0041 2412 -1.1739 0.2406
prev~n*time_crtl_popdens*time 0.0074 0.0039 2412 1.8814 0.06

# social distancing
models_socdist <- list(models_o_socdist, 
                       models_c_socdist, 
                       models_e_socdist, 
                       models_a_socdist, 
                       models_n_socdist)

sum_tab_socdist <- summary_table(models_socdist, dv_name = 'socdist')

write.table(sum_tab_socdist, quote=F)

Value Std.Error DF t-value p-value
socdist~o*time_crtl_popdens -4e-04 0.0018 2396 -0.239 0.8111
socdist~c*time_crtl_popdens 8e-04 0.0018 2396 0.4223 0.6728
socdist~e*time_crtl_popdens -0.0012 0.0018 2396 -0.7034 0.4819
socdist~a*time_crtl_popdens 2e-04 0.0018 2396 0.1142 0.9091
socdist~n*time_crtl_popdens 2e-04 0.0018 2396 0.1124 0.9105
socdist~o*time_crtl_popdens*time 0 0.0019 2395 0.0154 0.9877
socdist~c*time_crtl_popdens*time -7e-04 0.0024 2395 -0.2708 0.7866
socdist~e*time_crtl_popdens*time -0.0011 0.0018 2395 -0.6193 0.5358
socdist~a*time_crtl_popdens*time -6e-04 0.002 2395 -0.3054 0.7601
socdist~n*time_crtl_popdens*time 9e-04 0.0019 2395 0.4509 0.6521

Conditional random forest analysis

Extract slopes prevalence

Extract slopes social distancing

# slope socdist
df_uk_slope_socdist <- df_uk_socdist %>% split(.$nuts3) %>%
  map(~ lm(socdist_tiles ~ time, data = .)) %>%
  map(coef) %>%
  map_dbl('time') %>%
  as.data.frame() %>%
  rownames_to_column('nuts3') %>%
  rename(slope_socdist = '.')

# merge with control variables 
df_uk_slope_socdist <- df_uk_socdist %>% select(-time, -date, -socdist_tiles, -all_day_ratio_single_tile_users) %>%
  distinct() %>%
  inner_join(df_uk_slope_socdist, by = 'nuts3')

head(df_uk_slope_socdist)

Explore distribution of slopes

df_uk_slope_prev %>% ggplot(aes(slope_prev)) + geom_histogram(bins = 100)

df_uk_slope_socdist %>% ggplot(aes(slope_socdist)) + geom_histogram(bins = 100)